﻿#!/usr/bin/perl
use strict;
use warnings;
use encoding 'utf8';
use utf8;
use feature 'unicode_strings';
use Tie::File;

print "Next: Extract lexical entries\n";
#<stdin>;
print "Working...\n";
#&extract_lexical_entries;
print "Einträge exrtahiert.\n\n";

print "Next: Build tokenlist:\n";
#<stdin>;
print "Working...\n";
#&build_tokenlist;
print "Tokenlist built.\n\n";

print "Next: Build TNT-INPUT\n";
#<stdin>;
print "Working...\n";
&build_tnt_input;
print "All done!\n";

sub build_tokenlist{ #Searches results for Form and pos-tag
	my $derivation=10;
	my $parse=0;
	my $result=1;
	my $count=0;
	
	#(80 nach_sdepr-adv-mod -1.23159 0 1 ("nach" 272 "token
	#FIXME
	my $regex1 = qr/
		\(													#(
		\d+													#80
		\s 													# 
		([ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_-]+)				    #nach_sdepr-adv-mod
		\s 													#
		-?\d+\.?\d+											#-1.23159
		\s 													#
		\d+													#0
		\s 													#
		\d+													#1
		\s 													#
		\(													#(
		"													#"
		([ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzäüöÄÜÖ_-]+)				#nach
		"													#"
		\s 													#
		\d+													#272
		\s 													#
		"													#"
		token												#token
		 /x;
	open IDS, ">:utf8","parse_resultid.txt" or die $!;
	open TOKENLIST, ">tokenlist.txt" or die $!;
	open RESULT,  "<:utf8", "result" or die $!;
	print IDS "Parse\tResult-ID\n";
	while (<RESULT>){ #Read next sentence (line)
		chomp;
		my @fields=split(/@/, $_,); #Split at @
		print IDS $fields[$parse]."\t".$fields[$result]."\n";
		print $fields[$parse]."\t".$fields[$result]."\n";
		my @matches;
		push @matches, [$1, $2] while $fields[$derivation] =~ m/$regex1/gi; #Match according to regex
		for my $i ( 0 .. $#matches ) { #Put matches in file
			my $aref = $matches[$i];
			my $n = @$aref - 1;
			for my $j ( 0 .. $n ) {
				if ($j<$n){
				#print "$matches[$i][$j]\t";
				print TOKENLIST $matches[$i][$j]."\t";
				}
				else{
				#print "$matches[$i][$j]\n";
				print TOKENLIST $matches[$i][$j]."\n";
				}
			}
		}
		print TOKENLIST ".\tpunct\n"; #End of sentence  FIXME
		$count++;
		#sleep 1;
	}
	close TOKENLIST;
	close IDS;
	close RESULT;
}

sub extract_lexical_entries{ #Extract lexical entries from lexicon
	open TRIMMED, ">:utf8","lexicon_trim.tdl" or die $!;
	open LEXICON,  "<:utf8", "lexicon.tdl" or die $!;
	my $count = 0;
	while (<LEXICON>){
		chomp;
		if($_ =~ m/^(.*)\s\:=\s([ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_-]+)\s/){ #abbruch-n := count-noun-le &
		print $1."\t".$2."\n";	
			print TRIMMED $1."\t".$2."\n";
		}		
		$count++;
	}
	close TRIMMED;
	close LEXICON;
}


sub build_tnt_input{ #Look up tokens in lexicon and add tag/supertag
#FIXME
	my $count=0;
	open TOKENLIST,  "<:utf8", "tokenlist.txt" or die $!;
	open OUT, ">:utf8", "all.tt" or die $!;
	while (<TOKENLIST>){
		chomp;
		my @tfields=split(/\t/, $_,); #Split on Tabs
		if ($tfields[1] eq "punct"){#If end of sentence
			print "End of sentence.\n";
			print OUT ".\n\n";
		}
		else{#not end of sentence
			chomp @tfields;
			#tie my @lexicontrim, 'Tie::File', "lexicon_trim.tdl" or die $!;
			open LEXICONTRIM,  "<:utf8", "lexicon_trim.tdl" or die $!;
			while (<LEXICONTRIM>){
			#foreach (@lexicontrim){
				chomp $_;
				my @lfields=split(/\t/, $_,); 
				if ($tfields[0] eq $lfields[0]){ #If the pos-tag of the token matches the lexical item
					#print "\t".$tfields[1]."\t".$tfields[0]."\n";
					#print "\t".$lfields[0]."\t".$lfields[1]."\n";
					print "-->\t".$tfields[1]."\t".$lfields[1]."\n\n";
					print OUT $tfields[1]."\t".$lfields[1]."\n"; #Write surface of token and lexical entry to file
				}
			}
			#untie @lexicontrim;
			close LEXICONTRIM;
		}
		$count++;
	}
	close TOKENLIST;
	close OUT;
}

#TODO:
#Rewrite lookup with hashes
#Slicing per parse / result
#Getting regex to get all tokens
#Punctuation? Multi-word expressions?